perm filename RESPC.F4[PAG,LCS]15 blob
sn#513518 filedate 1980-05-26 generic text, type T, neo UTF8
00100 SUBROUTINE RESPC
00200 C RQ(2) IS R4, RQ(3) IS R5 ETC.
00300 COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00400 1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00500 1 RCLEF(0/7) /IVV/IV(1)
00600 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00700 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00800 COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00900 1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
01000 C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01100 DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01200 1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01300 INTEGER DUMMY
01400 COMMON /PX/PN(1) /Q/Q(1)
01500 1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01600 1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01700 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
01800 1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
01900 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02000 1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02100 1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02200 1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02300 DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
02400 1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/,ACCISZ/1.0/
02450 1 ,O1/0.01/
02500 C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
02600
02700 IF(NMPG.NE.'PAGEA')GO TO 2000
02800 C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
02900 RNEXT=0
03000 2000 SPCNT=1.0
03100 JX=0
03200 JCEN=0
03300 C FLAG FOR CENTERED RESTS.
03400 XT=0
03500 JK=1
03600 C JK IS USED AT END. IN SECTION TO FIND SIZE FACTOR FOR EACH BAR.
03700 PX=0
03800 CALL SHFT1(KQ)
03900 KK=L
04000 CC TYPE 3001,L
04100 C DELETES EXTRA BAR LINES, ETC.
04200 IF(IPG)CALL RESTS
04300 C??? IF(N)RETURN
04400 C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04500 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04600 CALL SHIFT
04700 C L=NUMBER OF ITEMS FOR RHY RECONS.
04800 JJ2=L+2
04900 C FOR WDCNT IN .PAG FILE
05000 IF(IPG.EQ.2)GO TO 11
05100 C IPG=2=REORDER INPUT FILE ONLY.
05200 N=0
05300 S=-100
05400 R=0
05500 KCLEF=0
05600 NOGRCE=-1
05700 C GRACE NOTE FLAG
05800 TTT=0
05900 C FOR IRREG. NUMS. OF STAVES.
06000
06100 C******** BIG LOOP ***************
06200 161 DO 601 K=1,L
06300 R=CODEN(KPN,K,Q,J)
06400 RZ=Q(J)
06500 CX J=KPN(K)
06600 CC N=N+1
06700 CC NN(N)=0
06800 CC MM(N)=J+3
06900 CALL MMNN(3)
07000 NN(N)=-R
07100 C MAKE ALL CODE NUMS NEG. AT FIRST. CHANGE 1,2,3,4,17,18 LATER
07200 CX R=Q(J+1)
07300 IF(R.GT.2)GO TO 1801
07400 IF(Q(J+2).GT.TTT)TTT=Q(J+2)
07500 C FINDS HIGHEST STAFF NUM. NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07600 IF(R.NE.1)GO TO 2801
07700 IF(RZ.LT.7)GO TO 601
07800 IF(Q(J+9).LE.0)GO TO 601
07900 C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
08000 IF(Q(J+9).NE.4./88.)GO TO 702
08100 CC IF(Q(J+9).GT..05)GO TO 702
08200 CC IF(Q(J+8).EQ.1000)GO TO 601
08300 C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
08400 NOGRCE=0
08500 GO TO 601
08600 CCC2801 IF(R.NE.2)GO TO 1801
08700 2801 RS=Q(J+7)
08800 IF(RZ.LT.7)GO TO 3801
08900 C DELETE ALL UP TO LABEL 1801 LATER. NEW CENTERED REST FEATURE. 5/29/78
09000 CXX NN(N)=-NN(N)
09100 IF(Q(J+9).NE.0)Q(J+9)=-1
09200 C SET UP WHOLE REST CENTERING. (P9=-1 CAUSES CENTERING AT OUTPUT TIME.)
09300 IF(Q(J+8).EQ.0)GO TO 601
09400 C SKIP IF WHOLE REST OVER CUE NOTES. (P8=0)
09500 IF(RS.LE.0)GO TO 601
09600 C SKIP RESTS WITH NO RHYTHM VALUE IN P7
09700 GO TO 702
09800 C??? NOW MAKE CODE NUM. POS.
09900 CC NN(N)=R
10000 CC GO TO 688
10100 3801 IF(RZ.LT.5)GO TO 601
10200 IF(RS.LE.0)GO TO 601
10300 IF(IPG)GO TO 702
10400 IF(RZ.LT.6)GO TO 702
10500 IF(Q(J+6))GO TO 702
10600 C PARAM 6=-1 = INVISIBLE. SHOULDN'T BE WHOLE REST (P8) ANYWAY.
10700 RS=Q(J+3)
10800 C GET POS. OF CENTERED WHOLE REST
10900 TT=0
11000 B=Q(J+2)
11100 C GET THE STAFF NUM.
11200 DO 602 M=1,L
11300 T=CODEN(KPN,M,Q,JJ)
11400 A=Q(JJ+3)
11500 C GET POS. OF ITEM
11600 IF(A.GT.RS)GO TO 602
11700 C JUMP IF ITEM IS TO RIGHT OF REST
11800 IF(T.NE.4)GO TO 602
11900 C IS THE ITEM A BAR LINE
12000 IF(Q(JJ+4).LT.0)GO TO 602
12100 C**** SKIP IF INVIS. BAR (P4=-1)
12200 IF(A.GT.TT)TT=A
12300 C FINDS BAR LINE CLOSEST TO LEFT OF REST
12400 602 CONTINUE
12500 C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
12600 T=20000
12700 A=20000
12800 C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
12900 DO 613 M=1,L
13000 IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
13100 IF(Q(JJ).LT.7)GO TO 609
13200 C SKIP IF RHYTH NOT IN P9
13300 IF(Q(JJ+9).LT..05)GO TO 613
13400 C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
13500 609 B=Q(JJ+3)
13600 C POS. OF ITEM
13700 X=B-TT
13800 IF(X)GO TO 613
13900 C JUMP IF ITEM IS TOO FAR TO LEFT
14000 IF(X.GT.A)GO TO 613
14100 A=X
14200 T=B
14300 C T = POS OF NOTE OR REST NEAREST BAR, ETC.
14400 613 CONTINUE
14500 IF(T.NE.20000)GO TO 612
14600 C JUMP IF NOTE OR REST FOUND
14700 JCEN=-1
14800 GO TO 1801
14900 612 Q(J+3)=T
15000 C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
15100 C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
15200 C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
15300 1801 IF(R.LT.4)GO TO 702
15400 IF(R.EQ.17)GO TO 1702
15500 IF(R.EQ.18)GO TO 1701
15600 IF(R.EQ.10)GO TO 702
15700 C FOUND A NUMBER. USE THIS IN RESTP
15800 IF(R.LE.7)GO TO 30
15900 IF(R.NE.44)GO TO 601
16000 IF(RZ.EQ.2)GO TO 601
16100 C RZ=2= BAR LINE ON UPPER STAFF
16200 IF(Q(J+6).EQ.0)GO TO 601
16300 IF(Q(J+5).EQ.0)GO TO 601
16400 C GETS LEFT END OF LINES, CRESC., DASHES.
16500 GO TO 604
16600 30 IF(R.NE.7)GO TO 605
16700 IF(RZ.LT.5)GO TO 604
16800 C JUMP FOR STANDARD TRILL
16900 RS=Q(J+7)
17000 IF(RS.EQ.1)GO TO 604
17100 IF(ABS(RS).GE.3)GO TO 604
17200 C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
17300 GO TO 601
17400 605 IF(R.NE.4)GO TO 604
17500 IF(Q(J+4).LT.0)GO TO 601
17600 C*** SKIP IF INVIS. BAR (P4=-1)
17700 IF(RZ.LE.3)GO TO 702
17800 C JUMP IF IT IS A BAR LINE
17900 CC IF(RZ.LT.4)GO TO 601
18000 IF(Q(J+6).NE.0)GO TO 604
18100 C GO GET OTHER POS OF LINE
18200 GO TO 601
18205 1701 IF(NN(N-1).NE.18)GO TO 1702
18207 IF(Q(J+2).EQ.Q(KPN(K-1)+2))Q(J+4)=-8.
18210 C SHIFT METER DOWN IF PREVIOUS ITEM WAS ALSO METER. (IN SAME POSITION)
18300 1702 IF(Q(J+4).NE.0)GO TO 601
18400 IF(Q(J+2).NE.0)GO TO 601
18500 C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
18600 702 NN(N)=-NN(N)
18700 CC702 NN(N)=R
18800 GO TO 601
18900 C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
19000 604 CALL MMNN(6)
19100 C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS (PUTS -1 INTO NN(X))
19200 CCXX NN(N)=-1
19300
19400 IF(R.NE.6)GO TO 601
19500 C NEXT FOR BEAMS
19600 IF(RZ.LT.8)GO TO 608
19700 IF(Q(J+10).EQ.0)GO TO 608
19800 IF(Q(J+8))GO TO 608
19900 C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
20000 IF(Q(J+7).GT.0)CALL MMNN(8)
20100 C NEXT SHIFTS P8 OF COMPOSITE BEAMS
20200 608 IF(RZ.LT.7)GO TO 601
20300 IF(Q(J+7))GO TO 688
20400 C P7 IS NEG FOR TREMOLO
20500 IF(Q(J+8).EQ.0)GO TO 601
20600 C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
20700 688 IF(Q(J+9).GT.0)CALL MMNN(9)
20800 C FOUND A POS. IN P9
20900 601 CONTINUE
21000
21100 KPG=TTT+1
21200 C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
21300
21400 C NEXT SORTS THE POINTS
21500 6000 J=1
21600 CC610 IF(NN(J).NE.-16)GO TO 1610
21700 C NEXT LOOKS FOR CONTINUATION OF TEXTS.(P10=1) PUTS ALL AT SAME P3 LOC.
21800 CC K=MM(J)
21900 CC IF(Q(K-3).LT.8)GO TO 1610
22000 CC IF(Q(K+7).EQ.1)Q(K)=Q(MM(J-1))
22100 CC GO TO 710
22200 CC1610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22300 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
22400 CALL EXCHG(MM(J),NN(J))
22500 C ABOVE EXCHGS --(J) AND --(J+1)
22600 IF(J.EQ.1)GO TO 710
22700 J=J-1
22800 GO TO 610
22900 710 J=J+1
23000 IF(J.LT.N)GO TO 610
23100 C NOW ALL SORTED
23200 CALL FNDEND(R)
23300 CALL SHFTQ(R)
23400 C SHIFTS TO PROPER HORIZ. POS.
23500 IF(IPG)CALL RESTP
23600 C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS. (FOR PARTS ONLY)
23700 IF(N.LE.0)GO TO 122
23800 C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
23900
24000 DO 119 K=1,150
24100 119 HH(K)=0
24200 C HH ARRAY WILL HOLD FINAL COMPOSITE.
24300 G(1)=0
24400 E(1)=0
24500 F(1)=0
24600 RN(1500)=0
24700 RN(2500)=0
24800 ST=0
24900 C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
25000 C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
25100 KE=0
25200 J=1000
25300 933 JJ=1500
25400 JJJ=2000
25500 T=0
25600 M=0
25700 A=0
25800 B=0
25900
26000 DO 33 K=1,N
26100 IF(NORH(KK,K))GO TO 33
26200 CC KK=NN(K)
26300 CC IF(KK.EQ.0)GO TO 33
26400 CC IF(KK.EQ.4)GO TO 2133
26500 CC IF(KK.EQ.17)GO TO 2133
26600 C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
26700 CC IF(KK.EQ.18)GO TO 2133
26800 CC IF(KK.GT.2)GO TO 33
26900 2133 LL=MM(K)-3
27000 IF(KK.LE.2)GO TO 1133
27100 RH=O1
27200 C RHYTHMIC VALUE OF BARLINE, METER, KSIG
27300 CCC IF(KK.NE.4)RH=.6
27400 GO TO 3133
27500 1133 IF(Q(LL+2).NE.ST)GO TO 33
27600 C JUMP IF NOT ON RIGHT STAFF
27700 RA=9
27800 IF(KK.EQ.2)RA=7
27900 IF(Q(LL).LT.RA-2)GO TO 33
28000 C JUMP IF WDCNT IS TOO SHORT
28100 IF(KK.EQ.1)GO TO 433
28200 IF(Q(LL).LT.6)GO TO 433
28300 C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
28400 RZ=Q(LL+8)
28500 C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
28600 IF(RZ.LE.0)GO TO 433
28700 Q(LL+7)=2
28800 C 2 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST (WAS 3)
28900 IF(RZ.LT.8)GO TO 433
29000 Q(LL+5)=-3
29100 C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
29200 RZ=RZ/2.0
29300 CC RZ=IFIX(RZ/2.0)+1.0
29400 IF(RZ.GT.6)RZ=6
29500 C LIMIT OF 8 ON RHYTH VAL.
29600 Q(LL+7)=RZ
29700 433 RH=Q(LL+IFIX(RA))
29800 IF(RH.EQ.0)GO TO 33
29900 3133 RZ=Q(LL+3)
30000 IF(ZERO(RZ,A).EQ.0)GO TO 133
30100 C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
30200 RRH=RH
30300 C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
30400 TT=T
30500 C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
30600 J=J+1
30700 C UPDATE COUNTER IN POSITION ARRAY
30800 T=T+RH
30900 C ADD TO TOTAL RHYTHM
31000 RN(J)=T
31100 A=Q(LL+3)
31200 C SAVE POS. OF THIS NOTE.
31300 GO TO 33
31400 133 IF(RH.EQ.RHH)GO TO 33
31500 C IGNORE 2ND RHYTH IF SAME AS FIRST
31600 IF(ZERO(RZ,B).EQ.0)GO TO 333
31700 C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
31800 TTT=TT
31900 C SAVE TOTAL RHYTHM TO THIS POINT.
32000 TT=TT+RH
32100 JJ=JJ+1
32200 C UPDATE COUNTER FOR 2ND ARRAY
32300 RN(JJ)=TT
32400 RRRH=RH
32500 B=A
32600 GO TO 33
32700 333 IF(RH.EQ.RRRH)GO TO 33
32800 TTT=TTT+RH
32900 JJJ=JJJ+1
33000 RN(JJJ)=TTT
33100 33 CONTINUE
33200 C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
33300 IF(ST.NE.0)GO TO 733
33400 KE=J-999
33500 C TOTAL NUM OF RHYTHMS ON STAFF1.
33600 CC IF(JPG.EQ.0)GO TO 2233
33700 IF(KPG.LE.1)GO TO 2233
33800 C KPG=0=PARTS; =1=PAGE, 1 STAFF
33900 C JUMP IF ONLY ONE STAFF
34000 C****733 KF=J-2499
34100 C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
34200 733 ST=ST+1
34300 IF(ST.GT.1)GO TO 833
34400 C JUMP IF ALL STAVES HAVE BEEN READ.
34500 1233 J=2500
34600 GO TO 933
34700 833 IF(J.NE.2500)GO TO 1533
34800 C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
34900 C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
35000
35100 2233 CALL RLOOP(HH,E,KE)
35200 C FOR SINGLE STAFF OF RHYTHM
35300 KL=KE
35400 GO TO 1333
35500 1533 K=1
35600 L=1
35700 M=0
35800 19 KK=K
35900 LL=L
36000 1 SM=10000
36100 K=K+1
36200 IF(K.GT.KE)GO TO 10
36300 4 L=L+1
36400 Y=F(L)
36500 B=Y-F(L-1)
36600 IF(B.LT.SM)SM=B
36700 2 X=E(K)
36800 A=X-E(K-1)
36900 C A AND B HAVE TRUE DURATIONS NOW
37000 IF(A.LT.SM)SM=A
37100 C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
37200 IF(ZERO(X,Y).EQ.0)GO TO 3
37300 C JUMP IF EQUAL RHYTHS
37400 IF(X.GT.Y)GO TO 4
37500 K=K+1
37600 C STEP FORWARD UNTIL X IS .GT. Y
37700 GO TO 2
37800 3 IF(K.NE.KK+1)GO TO 13
37900 IF(L.NE.LL+1)GO TO 14
38000 M=M+1
38100 G(M)=E(KK)
38200 GO TO 19
38300 13 IF(L.NE.LL+1)GO TO 15
38400 DO 16 J=KK,K-1
38500 M=M+1
38600 16 G(M)=E(J)
38700 GO TO 19
38800 14 DO 17 J=LL,L-1
38900 M=M+1
39000 17 G(M)=F(J)
39100 GO TO 19
39200 15 XM=SM-.001
39300 M=M+1
39400 P=E(KK)
39500 G(M)=P
39600 7 KK=KK+1
39700 LL=LL+1
39800 YM=SM*1.5
39900 C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
40000 S=P
40100 T=P
40200 27 A=E(KK)
40300 B=F(LL)
40400 IF(ZERO(A,B).EQ.0)GO TO 19
40500 X=ZERO(A,P)
40600 Y=ZERO(B,P)
40700 C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT.O1)ZERO=0
40800 S=E(KK-1)
40900 T=F(LL-1)
41000 9 IF(A-S.LT.X-O1)X=ZERO(A,S)
41100 IF(B-T.LT.Y-O1)Y=ZERO(B,T)
41200 IF(A.GT.B+O1)GO TO 8
41300 B=A
41400 KK=KK+1
41500 62 IF(X.GT.YM)GO TO 5
41600 IF(X.EQ.0)GO TO 27
41700 P=P+SM
41800 25 M=M+1
41900 G(M)=P
42000 GO TO 27
42100 5 P=P+SM
42200 IF(P)GO TO 2203
42300 C IF(P)ERROR
42400 IF(P.LT.B-O1)GO TO 5
42500 GO TO 25
42600 8 X=Y
42700 LL=LL+1
42800 GO TO 62
42900 10 M=M+1
43000 G(M)=E(KE)
43100 CC TYPE 410,(E(K),K=1,KE)
43200 CC TYPE 410,(F(K),K=1,KF)
43300 CC TYPE 410,(G(K),K=1,M)
43400 CBCB WRITE(21,410)(E(K),K=1,KE)
43500 CB WRITE(21,410)(F(K),K=1,KF)
43600 CB WRITE(21,410)(G(K),K=1,M)
43700 410 FORMAT(10F7.2)
43800 C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
43850 C****** NO VITAL RHYTHMS CAN PASS BAR LINES *************
43900 1033 JJ=1
44000 H(1)=0
44100 J=1
44200 K=2
44300 L=2
44400 511 IF(J.EQ.M)GO TO 911
44500 J=J+1
44600 X=G(J)
44700 1211 A=E(K)
44800 B=F(L)
44900 Y=ZERO(X,A)
45000 Z=ZERO(X,B)
45100 IF(A-B.GT.O1)GO TO 1111
45200 IF(Y.EQ.0)GO TO 1311
45300 IF(X.LT.A-O1)GO TO 1111
45400 K=K+1
45500 1411 JJ=JJ+1
45600 H(JJ)=-A
45700 GO TO 1211
45800 1111 IF(Z.EQ.0)GO TO 1311
45900 IF(X.LT.B-O1)GO TO 1311
46000 L=L+1
46100 A=B
46200 GO TO 1411
46300
46400 1311 JJ=JJ+1
46500 H(JJ)=X
46600 IF(Y.EQ.0)GO TO 611
46700 IF(Z.EQ.0)GO TO 711
46800 IF(ZERO(A,B).EQ.0)GO TO 511
46900 P=A
47000 IF(P.GT.B+O1)GO TO 811
47100 IF(P.GT.X+O1)GO TO 511
47200 K=K+1
47300 GO TO 1011
47400 811 P=B
47500 IF(P.GT.X+O1)GO TO 511
47600 L=L+1
47700 1011 JJ=JJ+1
47800 H(JJ)=-P
47900 C NON-SPACED RHYTHS ARE NEG.
48000 GO TO 511
48100 611 K=K+1
48200 IF(Z.GT.0)GO TO 511
48300 711 L=L+1
48400 GO TO 511
48500 911 IF(HH(2).EQ.0)GO TO 2011
48600 K=2
48700 J=2
48800 L=1
48900 HHH(1)=0
49000 1511 IF(J.GT.JJ)GO TO 1811
49100 P=H(J)
49200 A=ABS(P)
49300 B=ABS(HH(K))
49400 IF(ZERO(B,A).EQ.0)GO TO 1611
49500 IF(A.GT.B)GO TO 1711
49600 J=J+1
49700 GO TO 1911
49800 1711 P=HH(K)
49900 GO TO 2211
50000 1611 J=J+1
50100 2211 K=K+1
50200 1911 L=L+1
50300 HHH(L)=P
50400 GO TO 1511
50500 2011 CALL RLOOP(HH,H,JJ)
50600 KL=JJ
50700 GO TO 2111
50800 1811 CALL RLOOP(HH,HHH,L)
50900 KL=L
51000 2111 IF(ST.GE.KPG)GO TO 1333
51100 CALL RLOOP(E,G,M)
51200 KE=M
51300 C GO WAY BACK AND READ ANOTHER LINE.
51400 GO TO 1233
51500 1333 E(1)=0
51600 GO TO 2333
51700 TYPE 410,(HH(K),K=1,KL)
51800 WRITE(21,410)(HH(K),K=1,KL)
51900 2333 JD=1
52000 C JD IS COUNTER FOR DUMMY POSITIONS.
52100 DUMMY(1)=1
52200 ST=0
52300 183 B=0
52400 LL=2
52500
52600 DO 181 K=1,N
52700 IF(NORH(L,K))GO TO 181
52800 C LOOK FOR DUMMY RHYTHMS.
52900 IF(L.LE.2)GO TO 2184
53000 RZ=O1
53100 C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
53200 GO TO 1184
53300 2184 LF=MM(K)
53400 IF(Q(LF-1).NE.ST)GO TO 181
53500 C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
53600 J=6
53700 IF(L.EQ.2)J=4
53800 RZ=Q(LF+J)
53900 1184 B=B+RZ
54000 184 V=ABS(HH(LL))
54100 IF(ZERO(B,V).GT.0)GO TO 182
54200 C FOUND RHYTH MATCH
54300 JD=JD+1
54400 DUMMY(JD)=LL
54500 LL=LL+1
54600 GO TO 181
54700 182 IF(B.LT.V-O1)GO TO 181
54800 LL=LL+1
54900 GO TO 184
55000 181 CONTINUE
55100 ST=ST+1
55200 IF(ST.LT.KPG)GO TO 183
55300
55400 C NEXT SORT DUMMY ARRAY
55500 J=0
55600 185 DO 186 K=2,JD
55700 IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
55800 DO 188 LL=K,JD
55900 188 DUMMY(LL-1)=DUMMY(LL)
56000 JD=JD-1
56100 GO TO 185
56200 187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
56300 CALL EXCH(DUMMY(K),DUMMY(K-1))
56400 GO TO 185
56500 186 CONTINUE
56600 C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
56700 PX=0
56800 LF=0
56900 K=1
57000 V=0
57100
57200 81 K=K+1
57300 IF(K.GT.KL)GO TO 1433
57400 B=HH(K)
57500 A=B-V
57600 V=B
57700 IF(V)GO TO 82
57800 85 W=V
57900 IF(A.GT.O1)GO TO 89
57950 C WAS 0.011
58000 C .GT. BECAUSE OF ROUND-OFF ERROR (WAS 0.01 ABOVE AND BELOW 10/79)
58100 T=5
58200 IF(HH(K+1)-V.LE.O1)T=2
58210 C WAS 0.011
58300 PX=PX+T
58400 C THIS FOR BARS, KSIG, METER
58500 GO TO 189
58600 89 PX=PX+14.0*EXP(ALOG(A)*0.5849624)
58700 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
58800 CC89 PX=PX+PFIBX(A)
58900 189 E(K)=PX
59000 IF(LF.NE.0)GO TO 86
59100 GO TO 81
59200 82 LF=K
59300 83 K=K+1
59400 V=HH(K)
59500 IF(V)GO TO 83
59600 A=V-W
59700 GO TO 85
59800 86 LL=LF-1
59900 D=E(K)-E(LL)
60000 87 S=-HH(LF)-HH(LL)
60100 T=HH(K)-HH(LL)
60200 T=S/T
60300 C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
60400 E(LF)=E(LL)+D*T
60500 LF=LF+1
60600 IF(LF.NE.K)GO TO 87
60700 LF=0
60800 GO TO 81
60900
61000 1433 GO TO 2433
61100 TYPE 410,(E(K),K=1,KL)
61200 WRITE(21,410)(E(K),K=1,KL)
61300 C 5 IS SPACE AFTER 1ST BARLINE
61400 2433 IF(Q(2).EQ.18)RNEXT=RNEXT-3.6
61500 C PUSH CLOSER TO PREVIOUS BARLINE IF 1ST ITEM IS METER
61600 R8=RNEXT
61700 C POS OF 1ST BAR = END OF PREV. LINE
61800 IF(ENDLN.EQ.0)RNEXT=9
61900 C MAKES ROOM FOR 1ST CLEF.
62000 KL=KL-1
62100 J=0
62200 R5=0
62300 KK=1
62400 JD=1
62500 W=0
62600 LF=0
62700
62800 DO 80 K=1,N
62900 IF(NORH(L,K))GO TO 80
63000 A=Q(MM(K))
63100 IF(ZERO(A,W).EQ.0)GO TO 80
63200 C SKIP IF SAME POS OF NOTE OR REST.
63300 W=A
63400 R7=R8
63500 190 J=J+1
63600 IF(J.LE.KL)GO TO 290
63700 203 FORMAT(' FOUND CENTERED WHOLE REST!')
63800 2203 LL=0
63900 IF(JCEN.GE.0)GO TO 220
64000 TYPE 203
64100 GO TO 121
64200 220 JJJ=-1
64300 L=0
64400 120 W=LL
64500 A=0
64600 DO 124 KB=1,N
64700 LF=NN(KB)
64800 IF(LF.GT.2)GO TO 124
64900 IF(LF.LE.0)GO TO 124
65000 KE=MM(KB)
65100 IF(Q(KE-1).NE.W)GO TO 124
65200 C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
65300 JD=6
65400 IF(LF.EQ.2)JD=4
65500 A=A+Q(KE+JD)
65600 124 CONTINUE
65700 TYPE 123,LL,A
65800 LL=LL+1
65900 IF(L.EQ.0)L=A*100.+.5
66000 C SAVE NUM. OF BEATS FIRST TIME.
66100 IF(L.NE.A*100.+.5)JJJ=0
66200 C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
66300 IF(LL.LT.KPG)GO TO 120
66400 IF(JJJ.NE.0)GO TO 121
66500 JJJ=0
66600 DO 320 KB=2,JJ
66700 A=HH(KB)-HH(KB-1)
66800 IF(A.LE.O1)GO TO 320
66900 C SKIP BAR LINE VALUES (.01)
67000 JJJ=JJJ+1
67100 HH(JJJ)=4./A
67200 C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
67300 320 CONTINUE
67400 TYPE 420,(HH(KB),KB=1,JJJ)
67450 TYPE 421
67475 421 FORMAT(' **** COMPOSITE RHYTHM ERROR '/
67485 1 ' **** OR RHYTHM CROSSES BAR '/
67487 1 ' **** OR MISALIGNED NOTES')
67500 PAUSE
67600 GO TO 90
67800 420 FORMAT(10F8.2)
67900 123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
68000 121 PAUSE' *****RHYTHM MISMATCH*****'
68100 GO TO 90
68200 290 IF(DUMMY(JD).NE.J)GO TO 190
68300 JD=JD+1
68400 90 R8=RNEXT+E(J)
68500 R4=R5
68600 R5=A
68700 X=(R8-R7)/(R5-R4)
68800 S=R7-R4*X
68900 DO 91 L=KK,K
69000 LL=MM(L)
69100 91 Q(LL)=S+X*Q(LL)
69200 KK=K+1
69300 80 CONTINUE
69400
69500 CCC IF(KK.GT.K)GO TO 180
69600 IF(KK.GT.N)GO TO 180
69700 C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
69800 R7=Q(LL)-R5
69900 C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
70000 CCC DO 280 L=KK,K
70100 DO 280 L=KK,N
70200 LL=MM(L)
70300 280 Q(LL)=R7+Q(LL)
70400 180 JJ=JJ2-2
70500 L=JJ2
70600 M=0
70700 C FLAG FOR REST AT START OF LINE
70800
70900 JJJ=-1
71000 C FLAG FOR 1ST BAR OF LINE 12/77
71100 V=0
71200 ACCI=0
71300 DO 12 J=1,JJ
71400 R=CODEN(KPN,J,Q,LA)
71500 CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
71600 IF(R.EQ.4)GO TO 680
71700 IF(M)GO TO 780
71800 IF(R.NE.2)GO TO 780
71900 C NEXT FOR RESTS
72000 ACCI=ACCI+.5
72100 C ADD A LITTLE FOR TOTAL NUM. OF NOTES AND RESTS.
72200 C SHOULD WE ALSO CONSIDER CLEFS?? MAYBE ADD LATER.
72300 IF(KBR.EQ.0)GO TO 12
72400 C LOOK FOR RESTS AT FRONT OF LINE.
72500 X=0
72600 CALL TURN(J,JJ,1,X)
72700 PGTRN(KBR)=PGTRN(KBR)+X
72800 M=-1
72900
73000 780 IF(R.NE.1)GO TO 12
73100 IF(V.NE.Q(LA+3))GO TO 782
73200 IF(JACC)GO TO 781
73300 782 ACCI=ACCI+.5
73400 IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
73500 JACC=-1
73600 V=1
73700 C KPG=NUMB. OF STAVES BEING CONSIDERED. (IF 1, THEN ALL ACCIS ARE 'BIG')
73800 IF(KPG.GT.1)V=RSTFAC(IFIX(Q(LA+2))+1)
73900 CCCC V=RSTFAC(IFIX(Q(LA+2))+1)
74000 CC ACCI=ACCI+ACCISZ*RSTFAC(IFIX(Q(LA+2)))
74100 CCCC ACCI=ACCI+ACCISZ*V
74200 ACCI=ACCI+V
74300 C ADD SPACE FOR ACCIDENTALS*STAFF SIZE -- SEE DATA FOR ACCISZ.
74400 V=Q(LA+3)
74500 781 M=-1
74600 IF(NOGRCE)GO TO 12
74700 C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
74800 C FOUND A NOTE
74900 C************************* IF(Q(LA+9).GT.0.05)GO TO 12
75000 IF(Q(LA+9).NE.4.0/88.0)GO TO 12
75100 C JUMP IF NOT A GRACE NOTE
75200 R=Q(LA+2)
75300 C THE STAFF NUM.
75400 DO 580 LF=J+1,JJ
75500 IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
75600 IF(Q(JD+2).NE.R)GO TO 580
75700 IF(Q(JD).LT.7)GO TO 580
75800 IF(Q(JD+9).EQ.0)GO TO 580
75900 C CHORD NOTE
76000 R4=Q(LA+3)
76100 CC R4=Q(LA+3)-1
76200 R5=Q(JD+3)
76300 C THE STAFF # IS IN R2
76400 R8=RSTFAC(IFIX(R2+1))+.5
76500 IF(Q(JD+4).LT.80)R8=R8*2
76600 C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
76700 R8=R5-R8
76800 CC R8=R5-R8-1
76900 CCC IF(R4.EQ.R5)GO TO 12
77000 IF(R4.NE.R5)GO TO 480
77100 C GRACE NOTE AT START OF LINE ***** FIX THIS????
77200 DO 880 KE=1,LF-1
77300 880 Q(KPN(KE)+3)=R8
77400 C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
77500 GO TO 12
77600 480 R2=Q(LA+2)
77700 R9=R5
77800 CALL PTMOVE(Q,KPN)
77900 CC TYPE 9999,Q(J+3),Q(JD+3)
78000 CC9999 FORMAT(2F)
78100 GO TO 12
78200 580 CONTINUE
78300 GO TO 12
78400 C ABOVE FOR GRACE NOTE SPACING.
78500 680 KBR=KBR+1
78600 C BAR LINE COUNTER
78700 T=Q(LA+3)
78800 C TOTAL SPACE
78900 X=0
79000 CALL TURN(J-1,1,-1,X)
79100 CALL TURN(J+1,JJ,1,X)
79200 222 PGTRN(KBR)=X
79300 C FINDS PAGE-TURN POSSIBILITIES
79400 C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
79500 BFAC=.8
79600 CCC BFAC=.756
79700 IF(KPG.GT.1)CALL BARFAC(KPG,BFAC,JK)
79800 CC IF(KPG.LE.1)GO TO 3112
79900 C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
80000 CC R=RSTFAC(1)
80100 CC DO 5112 K=2,KPG
80200 CC5112 IF(R.NE.RSTFAC(K))GO TO 6112
80300 CC GO TO 3112
80400 C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
80500 C FIND LINE WITH MOST ACTIVITY.
80600 C ALL THIS SORT OF WORKS. SOMEDAY REVIEW IT.********
80700 CC6112 DO 1112 K=1,8
80800 CC1112 RN(K)=0
80900 CC DO 112 K=JK,J-1
81000 CC R=CODEN(KPN,K,Q,JD)
81100 CC IF(R.GT.3.)GO TO 112
81200 CC A=1.0
81300 C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
81400 CC IF(R.EQ.2)A=0.6
81500 C SKIP NON-RHYTHM CHORD NOTES. RESTS ARE CONSIDERED LESS IMPORTANT.
81600 CC IF(R.NE.1)GO TO 4112
81700 CC IF(Q(JD).LT.7)GO TO 112
81800 CC IF(Q(JD+9).LE.0)GO TO 112
81900 CC4112 LF=Q(JD+2)+1
82000 CC RN(LF)=RN(LF)+A
82100 CC112 CONTINUE
82200 CC JD=1
82300 CC B=RN(1)*RSTFAC(1)
82400 CC DO 2112 K=2,8
82500 CC A=RN(K)*RSTFAC(K)
82600 CC IF(A.LE.B)GO TO 2112
82700 CC JD=K
82800 CC B=A
82900 CC2112 CONTINUE
83000 CC BFAC=BFAC*(RSTFAC(JD)+.1)
83100 C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
83200 CXX BFAC=.84*RSTFAC(JD)
83300 3112 IF(JJJ)RNEXT=RNEXT-6
83400 C JJJ=-1 IF 1ST BAR OF LINE. 12/77
83500 JJJ=0
83600 BARS(KBR)=(T-RNEXT+ACCI)*BFAC
83700 C SIZE OF THIS MEASURE + ACCISZ*ACCIDENTALS
83800 ACCI=0
83900 C RESET ACCI (SPACE FOR ACCIS AND TOTAL NUM. OF NOTES)
84000 K=J
84100 JK=J+1
84200 C SET UP POINTER FOR NEXT BAR'S ITEMS.
84300 RNEXT=T
84400 12 CONTINUE
84500
84600 IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
84700 RNEXT=RNEXT+5
84800 CCC 11/9/78 RNEXT=RNEXT+3
84900 JJ2=L
85000 C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
85100 CC???380 LCNT=0
85200 CC??? NDPY=0
85300
85400 C JJ2 IS END OF PNTR DATA
85500 11 IF(IPG.EQ.2)NMPG=NAMX
85600 C IPG=2=REORDER INPUT FILE ONLY.
85705 C WHY DID I WRITE 2 EXTRA WORDS AT END OF Q ARRAY. (MAYBE NEEDED∞
85707 C BUT IF 1ST EXTRA WAS NEG. (OR ZER0?) CAUSED BUG IN NEW 'INUMS' ROUTINE.
85710 JPQ=KPN(JJ2-1)+1
85720 Q(JPQ-1)=0
85800 CALL PUTEXT(NMPG,'PAG')
85900 CALL EXTOUT(RSTFAC,128)
86000 C*** CALL EXTOUT(PN,JJ2)
86100 C NEW SAVE FORMAT DOESN'T NEED ABOVE 3/80
86200 CALL EXTOUT(Q,JPQ)
86300 IF(IPG.EQ.2)CALL EXIT
86400 CALL FINEXT
86500
86600 LASTNM=NMPG
86700 NMPG=NMPG+2
86800 IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
86900 C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
87000 IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
87100 IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
87200 122 ENDLN=RNEXT
87300 END